home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 090 / td2a.arc / TD2A.PAS < prev    next >
Pascal/Delphi Source File  |  1985-07-18  |  21KB  |  802 lines
  1. program td;   { version 2.12  Copright (c) 1985 by Mark Johnson 05/28/85 }
  2.  
  3.    { This program is protected under Copyright law.  It has been placed }
  4.    { in the public domain for personal non-commercial use only.  You    }
  5.    { may use this code, modify it, or give it away.  The author has     }
  6.    { relinquished personal gain from this program and so should you.    }
  7.    { This program was originally sold as a DEMO version.  The only      }
  8.    { documentation available is in the code.  If you are interested in  }
  9.    { more powerful versions for Pascal, COBOL, BASIC, PL/I, NEAT/3, or  }
  10.    { 8086 Assembler, Please contact the author.                         }
  11.    { This program is available written in NCR-COBOL, NCR ITX-Pascal and }
  12.    { IBM-PL/I for direct use on mainframes and minis.                   }
  13.  
  14.    { This program was originally written in PL/I to generate PL/I code, }
  15.    { then run through a PL/I to Pascal translator.  The output of the   }
  16.    { translator was cleaned up by hand.  Some months later when Turbo   }
  17.    { Pascal was released, a new version of this program was produced to }
  18.    { generate Pascal code.                                              }
  19.  
  20.    { Mark E. Johnson                 2272-F Benson Avenue               }
  21.    {                                 St. Paul Minnesota  55116          }
  22.    { evening phone                   612-698-3686                       }
  23.  
  24.    {      Input is a full screen, with output variables designated by   }
  25.    { leading !'s and input variables designated by leading #'s          }
  26.    { Integers have scale 0, reals have scale > 0                        }
  27.  
  28.  
  29.    { Revisions                                                          }
  30.    { Changed inname, outname and libname to 63 characters for paths     }
  31.    { Changed inname, outname and libname to typed constants             }
  32.    { Changed "copy(x, i, 1) to x[i]"                                    }
  33.    { Added forced input for empty inname and outname                    }
  34.    { Added quit option                                                  }
  35.    { Stopped printing "var" for varflg, but no variables                }
  36.    { Added a function getstr to TD.LIB to get string input              }
  37.    { Modified Turbodraw for string output variables to use getstr       }
  38.  
  39.  
  40. const
  41.   debug = false;
  42.  
  43. type
  44.   ltype = string[85];
  45.   stype = string[10];
  46.   fname_typ = string[63];  {L.P.}
  47.  
  48. const
  49.  
  50.   inname    : fname_typ = '';
  51.   outname   : fname_typ = '';
  52.   libname   : fname_typ = 'e:\includes\pascal\turbo\td.lib';
  53.  
  54. var   { this could have been a RECORD, but the PL/I to Pascal translator }
  55.       { is a bit stupid.                                                 }
  56.  
  57.     rtype     : array[1..64] of integer;
  58.     rname     : array[1..64] of ltype;
  59.     rx        : array[1..64] of integer;
  60.     ry        : array[1..64] of integer;
  61.     rlen      : array[1..64] of integer;
  62.     rscale    : array[1..64] of integer;
  63.     rorder    : array[1..64] of integer;
  64.  
  65.  
  66.     ndx       : integer;
  67.     line      : ltype;
  68.     lineno    : integer;
  69.     colno     : integer;
  70.     token     : ltype;
  71.     tail      : string[32];
  72.     i,j,l     : integer;
  73.     incr      : integer;
  74.     outtype   : char;
  75.     ans       : char;
  76.     infile    : text;
  77.     outfile   : text;
  78.     libfile   : text;
  79.     procname  : string[32];
  80.     varfl     : boolean;
  81.     librfl    : boolean;
  82.     subrfl    : boolean;
  83.     ctemp     : stype;
  84.     efile     : boolean;
  85.     level     : integer;
  86.     lib_ent   : BOOLEAN;  {True if Library Input File name exists. L.P.}
  87.     var_xst   : BOOLEAN;  {True if a variable exists. L.P.}
  88.  
  89. label
  90.     generate, retry, endinp;
  91.  
  92. function toupper(mess : ltype) : ltype;
  93. var
  94.   temp : ltype;
  95.   i    : integer;
  96.  
  97. begin
  98.   temp:='';
  99.   for i:=1 to length(mess) do
  100.     temp:=concat(temp,upcase(mess[i]));
  101.   toupper:=temp;
  102. end;
  103.  
  104. procedure space(n : integer);
  105. var
  106.   i  : integer;
  107.  
  108. begin
  109.     writeln;
  110.     for i:=1 to n do
  111.       write(' ');
  112. end;
  113.  
  114. procedure enter(mess : ltype);   { ENTER and LEAVE are debugging routines }
  115. begin                            { no longer used in this program.        }
  116.   if debug then
  117.     begin
  118.     level:=level+1;
  119.     space(level);
  120.     write(' Entering - ',mess);
  121.   end;
  122. end;
  123.  
  124. procedure leave(mess : ltype);
  125. begin
  126.   if debug then
  127.     begin
  128.     level:=level-1;
  129.     space(level);
  130.     write(' Leaving - ',mess)
  131.   end;
  132. end;
  133.  
  134. function convert(num : integer) : stype;
  135.  
  136. var
  137.   st1  : stype;
  138.  
  139. begin
  140.   str(num,st1);
  141.   while st1[1] = ' ' do
  142.     st1:=copy(st1,2,length(st1)-1);
  143.   convert:=st1;
  144. end;
  145.  
  146. procedure setup;
  147. var
  148.   ans    : char;
  149.   iotype : string[8];
  150.   ftype  : char;
  151.  
  152. begin
  153.   for i:=1 to ndx-1 do
  154.     begin
  155.     if rtype[i] > 0 then
  156.       begin
  157.       clrscr;
  158.       iotype:='Out Alfa 1';
  159.       if rtype[i] = 2 then
  160.         iotype:='In Alfa 2'
  161.       else if rtype[i] = 3 then
  162.         iotype:='In Num 3';
  163.  
  164.       gotoxy(23,2);
  165.       write('Variable Definitions');
  166.       gotoxy(20,5);
  167.       write('NAME   - ');
  168.       lowvideo;
  169.       write(rname[i]);
  170.       highvideo;
  171.       gotoxy(20,7);
  172.       write('TYPE   - ');
  173.       lowvideo;
  174.       write(iotype);
  175.       highvideo;
  176.       gotoxy(20,8);
  177.       write('LENGTH - ');
  178.       lowvideo;
  179.       write(rlen[i]);
  180.       highvideo;
  181.       gotoxy(20,10);
  182.       write('SCALE  - ');
  183.       lowvideo;
  184.       write(rscale[i]);
  185.       highvideo;
  186.       gotoxy(10,20);
  187.       write('Change or add to this record?');
  188.       gotoxy(1,21);
  189.       read(kbd,ans);
  190.       if (ans='y') or (ans='Y') then
  191.         begin
  192.         if rtype[i]=2 then
  193.           begin
  194.           gotoxy(10,20);
  195.           CLREOL; {L.P.}
  196.           write('N)umeric or A)lpha (N or A)');
  197.           gotoxy(40,7);
  198.           read(kbd,ans);
  199.           if (ans='n') or (ans='N') then
  200.             rtype[i]:=3;
  201.         end;
  202.         gotoxy(10,20);
  203.         CLREOL; {L.P.}
  204.         write('Enter length ( 1 - 80 ) ');
  205.         rlen[i] := 0; {L.P.}
  206.         WHILE rlen[i] = 0 DO {L.P.}
  207.           BEGIN {L.P.}
  208.             gotoxy(40,8); {L.P.}
  209.             CLREOL; {L.P.}
  210.             readln(rlen[i]);
  211.             IF ((rlen[i] < 1) OR (rlen[i] > 80)) THEN rlen[i] := 0; {L.P.}
  212.           END; {WHILE rlen[i]} {L.P.}
  213.         if (rtype[i]=3) or (rtype[i]=1) then
  214.           begin
  215.           gotoxy(10,20);
  216.           CLREOL; {L.P.}
  217.           write('Enter Scale (0 for integers, 1  - 15 for reals)'); {L.P.}
  218.           rscale[i] := -1; {L.P.}
  219.           WHILE rscale[i] < 0 DO {L.P.}
  220.             BEGIN {L.P.}
  221.               gotoxy(40,10); {L.P.}
  222.               CLREOL; {L.P.}
  223.               readln(rscale[i]);
  224.               IF ((rscale[i] < 0) OR (rscale[i] > 15)) THEN rscale[i] := -1;
  225.                                                                         {L.P.}
  226.             END; {WHILE rscale[i]} {L.P.}
  227.         end;
  228.         { i:=i-1; }
  229.       end;
  230.     end;
  231.   end;
  232. end;
  233.  
  234. function getvar(line : ltype) : ltype;
  235. var
  236.   k     : integer;
  237.  
  238. begin
  239.   incr:=0;
  240.   if (line[1]='!') or (line[1]='#') then
  241.     begin
  242.     k:=pos(' ',line);
  243.     if k = 0 then
  244.       getvar:=line
  245.     else
  246.       begin
  247.       incr:=k-1;
  248.       getvar:=(copy(line,1,k-1))
  249.     end;
  250.   end
  251.   else
  252.     begin
  253.     k:=pos('!',line);
  254.     if k=0 then
  255.       k:=pos('#',line);
  256.     if k=0 then
  257.       getvar:=line
  258.     else
  259.       begin
  260.       incr:=k-1;
  261.       getvar:=copy(line,1,k-1);
  262.     end;
  263.   end;
  264. end;
  265.  
  266. function deblank(str1 : stype) : stype;
  267. var
  268.   str2      : stype;
  269.   c         : char;
  270.   i         : integer;
  271.  
  272. label 99;
  273.  
  274. begin
  275.   enter('Function deblank');
  276.   str2:=str1;
  277.   if (str2[1]='!') or (str2[1]='#') then
  278.     str2:=copy(str2,2,(length(str2)-1)+1);
  279.   for i:=length(str2) downto 1 do
  280.     begin
  281.     if str2[i] <> ' ' then
  282.       goto 99;
  283.   end;
  284. 99:
  285.   deblank:=copy(str2,1,i);
  286. end;
  287.  
  288. function verify(st2 : ltype) : integer;  { return pos of 1st non-space }
  289. var
  290.   i    : integer;
  291. label gotit;
  292.  
  293. begin
  294.   for i:=1 to length(st2) do
  295.    if st2[i] <> ' ' then
  296.      goto gotit;
  297.  
  298. gotit:
  299.   if i=length(st2) then  { all spaces }
  300.     verify:=0
  301.   else
  302.     verify:=i;
  303. end;
  304.  
  305.  
  306. Procedure menu;
  307. var
  308.   continue : boolean;
  309.  
  310.   PROCEDURE get_inf; {L.P.}
  311.  
  312.     begin
  313.       lowvideo;
  314.       gotoxy(40,9);
  315.       CLREOL; {L.P.}
  316.       gotoxy(40,9);
  317.       readln(inname);
  318.       highvideo;
  319.       inname:=toupper(inname);
  320.     end; { get_inf }
  321.  
  322.   PROCEDURE get_outf; {L.P.}
  323.  
  324.     begin
  325.       lowvideo;
  326.       gotoxy(40,10);
  327.       CLREOL; {L.P.}
  328.       gotoxy(40,10);
  329.       readln(outname);
  330.       highvideo;
  331.       outname:=toupper(outname)
  332.     end; { get_outf }
  333.  
  334. Begin {menu}
  335.  
  336.   Clrscr;
  337.   Gotoxy(11,1);
  338.   Write('Copyright (c) 1985  Mark E.Johnson - MicroTools Co.');
  339.   Gotoxy(1,2);
  340.   Write(' ');
  341.   Gotoxy(25,6);
  342.   Write('TurboDraw 2.0');
  343.   Gotoxy(27,7);
  344.   Write('File Menu');
  345.   continue:=true;
  346.   while continue do
  347.     begin
  348.     Gotoxy(16,9);
  349.     Write('1). Screen Input File   ');
  350.     lowvideo;
  351.     WHILE LENGTH(inname) = 0 DO get_inf; {L.P.}
  352.     Gotoxy(40,9);
  353.     Write(inname);
  354.     highvideo;
  355.     Gotoxy(16,10);
  356.     Write('2). Pascal Output File  ');
  357.     lowvideo;
  358.     WHILE LENGTH(outname) = 0 DO get_outf; {L.P.}
  359.     Gotoxy(40,10);
  360.     Write(outname);
  361.     highvideo;
  362.     Gotoxy(16,11);
  363.     Write('3). Library Input File  ');
  364.     lowvideo;
  365.     Gotoxy(40,11);
  366.     lib_ent := (LENGTH(libname) > 0); {L.P.}
  367.     IF lib_ent THEN Write(libname) ELSE WRITE('None entered');  {L.P.}
  368.     highvideo;
  369.     gotoxy(16,12);
  370.     write('4). Exit to main menu ');
  371.     Gotoxy(16,14);
  372.     Write('Enter Option 1,2,3, or 4  ');
  373.     Gotoxy(42,14);
  374.     read(kbd,ans);
  375.     if ans='4' then
  376.       continue:=false
  377.     else
  378.       begin
  379.       Gotoxy(16,14);
  380.       Write('Enter File name or <C/R>   ')
  381.     end;
  382.     if ans='1' then get_inf {L.P.}
  383.     else if ans='2' then get_outf {L.P.}
  384.     else if ans='3' then
  385.       begin
  386.       lowvideo;
  387.       gotoxy(40,11);
  388.       CLREOL; {L.P.}
  389.       gotoxy(40,11);
  390.       readln(libname);
  391.       highvideo;
  392.       libname:=toupper(libname);
  393.       lib_ent := (LENGTH(libname) > 0); {L.P.}
  394.       gotoxy(40,11); {L.P.}
  395.       IF lib_ent THEN Write(libname) ELSE WRITE('None entered');  {L.P.}
  396.     end;
  397.   end;
  398. End; {menu}
  399.  
  400. procedure wrname(i : integer);
  401. var
  402.   x : integer;
  403. begin
  404.   for x:=1 to 20 do
  405.     if x <= length(rname[i]) then
  406.       write(rname[i][x]);
  407. end;
  408.  
  409. procedure sort;
  410. var
  411.     htype     : integer;
  412.     hname     : ltype;
  413.     hx        : integer;
  414.     hy        : integer;
  415.     hlen      : integer;
  416.     hscale    : integer;
  417.     horder    : integer;
  418.  
  419.     litvar,iotype,ftype : stype;
  420.     junk      : char;
  421.     ord1,ord2 : integer;
  422.     i,j       : integer;
  423.     again,l1  : boolean;
  424.  
  425. label ordl,endsort;
  426.  
  427. begin
  428.     while true do
  429.         begin
  430.         clrscr;
  431.         lowvideo;
  432.         write('Order Field Name               Literal/Variable  Input/Output  Alpha/Numeric');
  433.         highvideo;
  434.  
  435.         j:=1;
  436.         for i:=1 to ndx-1 do
  437.             begin
  438.             if j > 18 then
  439.                 begin
  440.                 j:=1;
  441.                 gotoxy(1,22);
  442.                 write('Press a key to continue ');
  443.                 read(kbd,junk);
  444.                 clrscr;
  445.                 lowvideo;
  446.                 writeln('Order Field Name               Literal/Variable  Input/Output  Alpha/Numeric');
  447.                 highvideo;
  448.  
  449.             end;
  450.             litvar:='Variable';
  451.             iotype:='Output';
  452.             ftype:='Alpha';
  453.             if rtype[i]=0 then
  454.                 litvar:='Literal'
  455.             else if rtype[i]=2 then
  456.                 iotype:='Input'
  457.             else if rtype[i]=3 then
  458.                 begin
  459.                 iotype:='Input';
  460.                 ftype:='Numeric'
  461.             end;
  462.             if rname[i] <> '' then
  463.                 begin
  464.                 gotoxy(1,j+1);
  465.                 write(rorder[i]:3);
  466.                 gotoxy(7,j+1);
  467.                 wrname(i);
  468.                 gotoxy(32,j+1);
  469.                 write(litvar);
  470.                 gotoxy(50,j+1);
  471.                 write(iotype);
  472.                 gotoxy(64,j+1);
  473.                 write(ftype);
  474.                 j:=j+1;
  475.             end;
  476.         end;
  477.         L1:=TRUE;
  478.         repeat
  479.             gotoxy(1,22);
  480.             write('Enter field to change, or 999 to quit    ');
  481.             lowvideo;
  482.             gotoxy(1,23);
  483.             write('      ');
  484.             gotoxy(1,23);
  485.             readln(ord1);
  486.             highvideo;
  487.             if ord1=999 then
  488.                 goto endsort;
  489.             for j:=1 to ndx-1 do
  490.                 if ord1=rorder[j] then
  491.                     goto ordl;
  492.  ordl:      if ord1 = rorder[j] then
  493.                 l1:=FALSE;
  494.         until NOT l1;
  495.         ord1:=j;
  496.         gotoxy(1,22);
  497.         write('Place at field #                        ');
  498.         lowvideo;
  499.         gotoxy(1,23);
  500.         write('     ');
  501.         gotoxy(1,23);
  502.         readln(ord2);
  503.         highvideo;
  504.         rorder[ord1]:=ord2;
  505.  
  506.  { Simple bubble sort is fast enough for this application }
  507.  
  508.         Again:=TRUE;
  509.         while again do
  510.             begin
  511.             Again:=FALSE;
  512.             for i:=1 to ndx-2 do
  513.                 begin
  514.                 If rorder[i] > rorder[i+1] Then
  515.                     begin
  516.                     hname:=rname[i];
  517.                     htype:=rtype[i];
  518.                     hx:=rx[i];
  519.                     hy:=ry[i];
  520.                     hlen:=rlen[i];
  521.                     hscale:=rscale[i];
  522.                     horder:=rorder[i];
  523.                     rname[i]:=rname[i+1];
  524.                     rtype[i]:=rtype[i+1];
  525.                     rx[i]:=rx[i+1];
  526.                     ry[i]:=ry[i+1];
  527.                     rlen[i]:=rlen[i+1];
  528.                     rscale[i]:=rlen[i+1];
  529.                     rorder[i]:=rorder[i+1];
  530.                     rname[i+1]:=hname;
  531.                     rtype[i+1]:=htype;
  532.                     rx[i+1]:=hx;
  533.                     ry[i+1]:=hy;
  534.                     rlen[i+1]:=hlen;
  535.                     rscale[i+1]:=hscale;
  536.                     rorder[i+1]:=horder;
  537.                     again:=TRUE;
  538.                 end;  { if rorder[i] }
  539.             end;      { for i:=1 to  }
  540.         end;          { while again  }
  541.      end;
  542.     endsort:
  543.  End;
  544.  
  545.  
  546. begin { main }
  547. retry:
  548.   menu;
  549.   level:=0;
  550.   varfl:=true;
  551.   librfl:=false;
  552.   subrfl:=false;
  553.   outtype:='C';
  554.   ndx:=1;
  555.   lineno:=1;
  556.   assign(infile,inname);
  557.   {$I-}
  558.   reset(infile);
  559.   {$I+}
  560.   if ioresult <> 0 then
  561.     begin
  562.     writeln;
  563.     writeln('Screen file not found, Press a key to continue ');
  564.     read(kbd,ans);
  565.     goto retry
  566.   end;
  567.   if lib_ent then {Check libname for validity L.P.}
  568.     begin
  569. {    assign(libfile,'TD.LIB');}  {Replaced by next line.  L.P.}
  570.      assign(libfile,libname); {L.P.}
  571.     {$I-}
  572.     reset(libfile);
  573.     {$I+}
  574.     if ioresult <> 0 then
  575.       begin
  576.       writeln('LIB file not found, Press a key to continue ');
  577.       read(kbd,ans);
  578.       close(infile);
  579.       goto retry
  580.     end  {; } {L.P.}
  581.     ELSE {L.P.}
  582.       close(libfile); {L.P.}
  583.   end;
  584.  
  585.   assign(outfile,outname);
  586.   rewrite(outfile);
  587.  
  588.   efile:=false;
  589.   while NOT efile do
  590.     begin
  591.     colno:=1;
  592.     incr := 0; {L.P.}
  593.     readln(infile,line);
  594.     if eof(infile) then
  595.       efile:=true;
  596.     l:=length(line);
  597.     i:=0;
  598.     while colno < l do
  599.       begin
  600.       i:=verify(line);
  601.       if (i=0) and (length(line) > 0) then
  602.         i:=1;
  603.       if i > 0 then
  604.         begin
  605.         colno:=colno+i+incr-1;
  606.         token:=GETVAR(copy(line,i,(length(line)-i)+1));
  607.         j:=i+length(token);
  608.         rtype[ndx]:=0;
  609.         if token[1] = '!' then
  610.           begin
  611.           rtype[ndx]:=1;
  612.           token:=copy(token,2,length(token)-1);
  613.         end
  614.         else if token[1] = '#' then
  615.           begin
  616.           rtype[ndx]:=2;
  617.           token:=copy(token,2,length(token)-1);
  618.         end;
  619.         rname[ndx]:= token;  {deblank(token);}
  620.         rx[ndx]:=lineno;
  621.         ry[ndx]:=colno;
  622.         rlen[ndx]:=0;
  623.         rscale[ndx]:=0;
  624.         rorder[ndx]:=ndx*10;
  625.         if j >= length(line) then
  626.           l:=0
  627.         else
  628.           line:=copy(line,j,(length(line)-j)+1);
  629.         ndx:=ndx+1;
  630.       end;
  631.     end;
  632.     lineno:=lineno+1;
  633.   end;
  634.  
  635. endinp:
  636.   close(infile);
  637.   while true do
  638.     begin
  639.     clrscr;
  640.     gotoxy(28,3);
  641.     write('TurboDraw');
  642.     gotoxy(28,6);
  643.     write('OPTIONS');
  644.     lowvideo;
  645.     gotoxy(19,10);
  646.     write('G - Generate code and exit');
  647.     gotoxy(19,11);
  648.     write('V - Variable declarations');
  649.     gotoxy(19,12);
  650.     write('O - Order of input/output');
  651.     gotoxy(19,13);
  652.     write('L - Include Library functions');
  653.     highvideo;
  654.     gotoxy(50,13);
  655.     IF lib_ent     {L.P.}
  656.       THEN         {L.P.}
  657.         BEGIN      {L.P.}
  658.           if librfl then
  659.             write('Yes')
  660.           else
  661.             write(' No');
  662.         END {lib_ent  L.P.}
  663.       ELSE {L.P.}
  664.         WRITE(' None entered'); {End IF lib_ent  L.P.}
  665.     lowvideo;
  666.     gotoxy(19,14);
  667.     write('P - Generate a procedure');
  668.     highvideo;
  669.     gotoxy(50,14);
  670.     if subrfl then write('Yes')
  671.       else write(' No');
  672.     lowvideo;
  673.     gotoxy(19,15);
  674.     write('I - Include VAR Definitions');
  675.     highvideo;
  676.     gotoxy(50,15);
  677.     if varfl then write('Yes')
  678.       else write(' No');
  679.     GOTOXY(19,17); {L.P.}
  680.     WRITE('Q - quit');
  681.     gotoxy(19,20);  {L.P.}
  682.     write('Enter Option: ');
  683.     read(kbd,ans);
  684.     case ans of
  685.       'p','P'  :    begin
  686.                       subrfl:=NOT subrfl;
  687.                       if subrfl then
  688.                         begin
  689.                         gotoxy(19,22);
  690.                         lowvideo;
  691.                         write('Enter name of procedure ');
  692.                         highvideo;
  693.                         readln(procname)
  694.                       end
  695.                     end;
  696.  
  697.        'l','L'  :  IF lib_ent THEN librfl:=NOT librfl; {L.P.}
  698.        'i','I'  :  varfl:=NOT varfl;
  699.        'g','G'  :  goto Generate;
  700.        'v','V'  :  Setup;
  701.        'o','O'  :  sort;
  702.        'q','Q'  :  BEGIN  {Quit.  L.P.}
  703.                      CLOSE(infile);  {L.P.}
  704.                      CLOSE(outfile); {L.P.}
  705.                      HALT; {L.P.}
  706.                    END; {'q','Q' L.P.}
  707.  
  708.   end;
  709. end;
  710.  
  711.        { Generate Code for TURBO PASCAL }
  712.  
  713. generate:
  714. writeln(outfile);
  715. writeln(outfile,'{ Start of Turbodraw code }');
  716.   if varfl then
  717.     begin
  718.     var_xst := FALSE; {L.P.}
  719.     for i:=1 to ndx-1 do
  720.       begin
  721.       if rtype[i] > 0 then
  722.         begin
  723.         if NOT var_xst THEN {L.P.}
  724.           BEGIN  {L.P.}
  725.             var_xst := TRUE; {L.P.}
  726.             writeln(outfile,'Var') {Moved.  L.P.}
  727.           END;  {L.P.}
  728.         writeln(outfile);
  729.         write(outfile,'  ',rname[i]);
  730.         if rtype[i] = 1 then
  731.           write(outfile,' : Integer;')
  732.         else if rtype[i] = 2 then
  733.           write(outfile,' : String[',convert(rlen[i]),'];')
  734.         else
  735.           begin
  736.           if rscale[i] > 0 then
  737.             write(outfile,' : Real;')
  738.           else
  739.             write(outfile,' : Integer;');
  740.         end;
  741.       end;
  742.     end;
  743.     writeln(outfile);
  744.   end;
  745.   writeln(outfile);
  746.   if lib_ent AND librfl then {L.P.}
  747.     begin
  748.     assign(libfile,libname);
  749.     reset(libfile);
  750.     while not eof(libfile) do     { Include library code }
  751.       begin
  752.       readln(libfile,line);
  753.       writeln(outfile,line);
  754.     end;
  755.   close(libfile)
  756.   end;
  757.   if subrfl then
  758.     begin
  759.     writeln(outfile);
  760.     writeln(outfile,'Procedure ',procname,';');
  761.     writeln(outfile,'Begin');
  762.     writeln(outfile,'  Clrscr;');
  763.   end;
  764.   for i:=1 to ndx-1 do
  765.     begin
  766.     if rname[i] > ' ' then
  767.       writeln(outfile,'  Gotoxy(',convert(ry[i]),',',convert(rx[i]),');');
  768.     if rtype[i]=0 then
  769.       begin
  770.       if rname[i] > ' ' then
  771.         writeln(outfile,'  Write(''',rname[i],''');');
  772.     end
  773.     else if rtype[i]=1 then
  774.       begin
  775.       tail:=convert(rlen[i]);
  776.       tail:=concat(':',tail);
  777.       if rscale[i] > 0 then
  778.         tail:=concat(tail,':',convert(rscale[i]));
  779.       tail:=concat(tail,');');
  780.       if rlen[i] = 0 then
  781.         writeln(outfile,'  Write(',rname[i],');')
  782.       else
  783.         writeln(outfile,'  Write(',rname[i],tail)
  784.     end
  785.  
  786.     ELSE IF (rtype[i] = 2) THEN {L.P.}
  787.       WRITELN(outfile, '  ', rname[i], ' := getstr(', convert(rlen[i]), ');')
  788.                                                                         {L.P.}
  789.  
  790.     else if (rtype[i]=3) then
  791.       if rscale[i] > 0 then
  792.         writeln(outfile,'  ',rname[i],':=Getreal(',convert(rlen[i]),',',convert(rscale[i]),');')
  793.       else
  794.         writeln(outfile,'  ',rname[i],':=Getint(',convert(rlen[i]),');');
  795.   end;
  796.   if subrfl then
  797.     writeln(outfile,'End;');
  798.   writeln(outfile,'{ End of Turbodraw Code }');
  799.   writeln(outfile);
  800.   close(outfile);
  801. end.
  802.